home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / tk / demos / mkRuler.tcl < prev    next >
Encoding:
Text File  |  1995-07-21  |  3.8 KB  |  126 lines
  1. # mkRuler w
  2. #
  3. # Create a canvas demonstration consisting of a ruler.
  4. #
  5. # Arguments:
  6. #    w -    Name to use for new top-level window.
  7. # This file implements a canvas widget that displays a ruler with tab stops
  8. # that can be set individually.  The only procedure that should be invoked
  9. # from outside the file is the first one, which creates the canvas.
  10.  
  11. proc mkRuler {{w .ruler}} {
  12.     global tk_library
  13.     upvar #0 demo_rulerInfo v
  14.     catch {destroy $w}
  15.     toplevel $w
  16.     dpos $w
  17.     wm title $w "Ruler Demonstration"
  18.     wm iconname $w "Ruler"
  19.     set c $w.c
  20.  
  21.     message $w.msg -font -Adobe-Times-Medium-R-Normal-*-180-* -width 13c \
  22.         -relief raised -bd 2 -text "This canvas widget shows a mock-up of a ruler.  You can create tab stops by dragging them out of the well to the right of the ruler.  You can also drag existing tab stops.  If you drag a tab stop far enough up or down so that it turns dim, it will be deleted when you release the mouse button."
  23.     canvas $c -width 14.8c -height 2.5c -relief raised
  24.     button $w.ok -text "OK" -command "destroy $w"
  25.     pack $w.msg $w.c -side top -fill x
  26.     pack $w.ok -side bottom -pady 5
  27.  
  28.     set v(grid) .25c
  29.     set v(left) [winfo fpixels $c 1c]
  30.     set v(right) [winfo fpixels $c 13c]
  31.     set v(top) [winfo fpixels $c 1c]
  32.     set v(bottom) [winfo fpixels $c 1.5c]
  33.     set v(size) [winfo fpixels $c .2c]
  34.     set v(normalStyle) "-fill black"
  35.     if {[tk colormodel $c] == "color"} {
  36.     set v(activeStyle) "-fill red -stipple {}"
  37.     set v(deleteStyle) "-stipple @$tk_library/demos/bitmaps/grey.25 \
  38.         -fill red"
  39.     } else {
  40.     set v(activeStyle) "-fill black -stipple {}"
  41.     set v(deleteStyle) "-stipple @$tk_library/demos/bitmaps/grey.25 \
  42.         -fill black"
  43.     }
  44.  
  45.     $c create line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1
  46.     for {set i 0} {$i < 12} {incr i} {
  47.     set x [expr $i+1]
  48.     $c create line ${x}c 1c ${x}c 0.6c -width 1
  49.     $c create line $x.25c 1c $x.25c 0.8c -width 1
  50.     $c create line $x.5c 1c $x.5c 0.7c -width 1
  51.     $c create line $x.75c 1c $x.75c 0.8c -width 1
  52.     $c create text $x.15c .75c -text $i -anchor sw
  53.     }
  54.     $c addtag well withtag [$c create rect 13.2c 1c 13.8c 0.5c \
  55.         -outline black -fill [lindex [$c config -bg] 4]]
  56.     $c addtag well withtag [rulerMkTab $c [winfo pixels $c 13.5c] \
  57.         [winfo pixels $c .65c]]
  58.  
  59.     $c bind well <1> "rulerNewTab $c %x %y"
  60.     $c bind tab <1> "demo_selectTab $c %x %y"
  61.     bind $c <B1-Motion> "rulerMoveTab $c %x %y"
  62.     bind $c <Any-ButtonRelease-1> "rulerReleaseTab $c"
  63. }
  64.  
  65. proc rulerMkTab {c x y} {
  66.     upvar #0 demo_rulerInfo v
  67.     $c create polygon $x $y [expr $x+$v(size)] [expr $y+$v(size)] \
  68.         [expr $x-$v(size)] [expr $y+$v(size)]
  69. }
  70.  
  71. proc rulerNewTab {c x y} {
  72.     upvar #0 demo_rulerInfo v
  73.     $c addtag active withtag [rulerMkTab $c $x $y]
  74.     $c addtag tab withtag active
  75.     set v(x) $x
  76.     set v(y) $y
  77.     rulerMoveTab $c $x $y
  78. }
  79.  
  80. proc rulerMoveTab {c x y} {
  81.     upvar #0 demo_rulerInfo v
  82.     if {[$c find withtag active] == ""} {
  83.     return
  84.     }
  85.     set cx [$c canvasx $x $v(grid)]
  86.     set cy [$c canvasy $y]
  87.     if {$cx < $v(left)} {
  88.     set cx $v(left)
  89.     }
  90.     if {$cx > $v(right)} {
  91.     set cx $v(right)
  92.     }
  93.     if {($cy >= $v(top)) && ($cy <= $v(bottom))} {
  94.     set cy [expr $v(top)+2]
  95.     eval "$c itemconf active $v(activeStyle)"
  96.     } else {
  97.     set cy [expr $cy-$v(size)-2]
  98.     eval "$c itemconf active $v(deleteStyle)"
  99.     }
  100.     $c move active [expr $cx-$v(x)] [expr $cy-$v(y)]
  101.     set v(x) $cx
  102.     set v(y) $cy
  103. }
  104.  
  105. proc demo_selectTab {c x y} {
  106.     upvar #0 demo_rulerInfo v
  107.     set v(x) [$c canvasx $x $v(grid)]
  108.     set v(y) [expr $v(top)+2]
  109.     $c addtag active withtag current
  110.     eval "$c itemconf active $v(activeStyle)"
  111.     $c raise active
  112. }
  113.  
  114. proc rulerReleaseTab c {
  115.     upvar #0 demo_rulerInfo v
  116.     if {[$c find withtag active] == {}} {
  117.     return
  118.     }
  119.     if {$v(y) != [expr $v(top)+2]} {
  120.     $c delete active
  121.     } else {
  122.     eval "$c itemconf active $v(normalStyle)"
  123.     $c dtag active
  124.     }
  125. }
  126.